home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / lastcom.zip / WINDOW.INC < prev   
Text File  |  1993-01-04  |  2KB  |  84 lines

  1. {the following subroutines provide further window capabilities to those offered
  2.  by the Turbo compiler. Note the following constants must be defined:
  3.  
  4.  first_row = the first row # to place window (upper left corner)
  5.  first_col = the first col # to place window
  6.  windowlength = the number of rows long window is to be
  7.  windowwidth = the number of columns wide
  8.  
  9.  in addition the structure savreg must be defined globally and be of the register type
  10.  used by turbo for system calls
  11. }
  12. var
  13.     savebuf:array [1..windowwidth] of array [1..windowlength] of integer;
  14.  
  15. {read/write a character from the screen at the current cursor position}
  16.  
  17. function GetScreenChar:integer;
  18. begin
  19.    savreg.ax := $0800;                 {9 -> get character/attr @ cursor}
  20.    savreg.bx := 0;
  21.    Intr($10,savreg);
  22.    GetScreenChar := savreg.ax
  23. end;
  24. procedure PutScreenChar(input:integer);
  25. begin
  26.    savreg.ax := $0900 + (input and $FF); {a -> put character/attr @ cursor}
  27.    savreg.bx := input shr 8;          {put the attrib in bl and 0 in bh}
  28.    savreg.cx := 1;
  29.    Intr($10,savreg)
  30. end;
  31. {.pa}
  32. {open a window and save the contents away}
  33.  
  34. procedure OpenWindow;
  35. var
  36.    i,j: Integer;
  37. begin
  38.    {open up the window area}
  39.  
  40.    window (first_col, first_row, first_col+windowwidth, first_row+windowlength);
  41.  
  42.    {save off the data in the window}
  43.  
  44.    for i := 1 to windowwidth do
  45.       for j := 1 to windowlength do
  46.       begin
  47.          GoToXY(i,j);
  48.          savebuf[i][j] := GetScreenChar      {get a attribute/character at the cursor}
  49.       end;
  50.  
  51.    {put the frame up around the window and clear that area}
  52.  
  53.    GotoXY(1,1);                              {clear the window now}
  54.    Write(chr(218));
  55.    for i:=2 to windowwidth-1 do Write(chr(196));
  56.    Write(chr(191));
  57.    for i:=2 to windowlength-1 do
  58.    begin
  59.       GotoXY(1, i);  Write(chr(179));
  60.       for j := 2 to windowwidth-1 do
  61.          Write(' ');
  62.       GotoXY(windowwidth, i);  Write(chr(179));
  63.    end;
  64.    GotoXY(1, windowlength);
  65.    Write(chr(192));
  66.    for i:=2 to windowwidth-1 do Write(chr(196));
  67.    Write(chr(217));
  68. end;
  69.  
  70. {the following procedure closes the previously opened window}
  71.  
  72. procedure closewindow;
  73. var
  74.    i,j:integer;
  75.  
  76. begin
  77.    for i := 1 to windowwidth do
  78.       for j := 1 to windowlength do
  79.       begin
  80.          GoToXY(i,j);
  81.          PutScreenChar(savebuf[i][j])
  82.       end
  83. end;
  84.